1 Introducción

Este documento consiste en una revisión del proceso de validación de EPSOC 2018. Se trata de un documento reproducible y dinámico que será actualizado cada vez que haya una nueva entrega de datos durante el trabajo de campo. El código está inserto dentro del documento, pero replegado. Para verlo hacer click en cuadro code.

2 Preámbulo

Se cargan los datos en el formato entregado y se homogeneiza el formato en minúscula y usando puntos (“.”) para separar en vez de guiones bajos (“_”).

pacman::p_load(tidyverse, lubridate, anytime, chron,
               haven, sf,
               sjlabelled, sjmisc, 
               validate, eeptools, kableExtra, janitor, here, naniar,
               captioner)

if(Sys.info()[["user"]] == 'caayala'){
  path <- "/Users/caayala/Dropbox (DESUC)/DESUC/Proyectos/3 Politicas Publicas/EPSOC 2018/BD"
} else if(Sys.info()[["user"]] == 'Andres') {
  path <- "/Users/Andres/Dropbox (DESUC)/Proyectos/3 Politicas Publicas/EPSOC 2018/BD"
}

epsoc <-haven::read_spss(file.path(path, '190404 - EPSOC Base parcial 25.sav')) %>% 
  clean_names() %>% 
  mutate(region = folio %/% 100000,
         region = labelled(region, 
                           labels = c('Antofagasta' = 2, 
                                      'Araucanía'= 9,
                                      'Metropolitana' = 13),
                           label = 'Región'),
         manzana = folio %/% 100,
         i_1_orden = as.integer(i_1_orden))

names(epsoc) <- tolower(gsub("_", ".", names(epsoc)))

# Agregar datos de la muestra a encuesta
suppressMessages(
  epsoc_muestra <- read_csv('../03-muestra_epsoc.csv')
)

epsoc <- left_join(epsoc,
                   epsoc_muestra %>% select(manzana = folio, estrato, sector),
                   by = 'manzana')
## Warning: Column `manzana` has different attributes on LHS and RHS of join
epsoc <- epsoc %>% 
  mutate(estrato = labelled(estrato, 
                            labels = c('Antofagasta - Bajo'    = 21,
                                       'Antofagasta - Medio'   = 22,
                                       'Temuco - Bajo'         = 91,
                                       'Temuco - Medio'        = 92,
                                       'Gran Santiago - Bajo'  = 131,
                                       'Gran Santiago - Medio' = 132,
                                       'Gran Santiago - Alto'  = 133),
                            label = 'Estratos de muestreo (Ciudad - nivel educacional de los jefes de hogar de las zonas censales)'))

grabacion <- FALSE
kable_estilo <- function(tabla){
  tabla %>% 
    kableExtra::kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
                              full_width=F)
}
makeVlist <- function(dta) { 
        labels <- sapply(dta, function(x) attr(x, "label"))
        tibble(name = names(labels),
               label = labels)
        
}  

## Etiquetas variables
labs.epsoc <- makeVlist(epsoc)
labs.epsoc <- labs.epsoc %>% 
  mutate(label2 = map_chr(label, toString))

labs.epsoc <- get_label(epsoc)

3 General

La actual base cuenta con 1290 casos recogidos entre el 2018-10-17 y el 2019-03-29.

3.1 Filtro de casos posiblemente duplicados

epsoc <- epsoc %>% 
  filter(duplicated(epsoc$folio, incomparables = FALSE) == FALSE)
epsoc %>% 
  count(region, status) %>% 
  spread(status, n) %>% 
  janitor::adorn_totals(where = c('row', 'col')) %>% 
  kable() %>% 
  kable_estilo()
region Aceptado Aceptado con reparos Total
2 303 57 360
9 171 190 361
13 422 147 569
Total 896 394 1290

Distribución según estratos de muestreo

frq(epsoc, estrato)
## 
## # Estratos de muestreo (Ciudad - nivel educacional de los jefes de hogar de las zonas censales) (estrato) <numeric> 
## # total N=1290  valid N=1290  mean=89.61  sd=45.69
##  
##  val                 label frq raw.prc valid.prc cum.prc
##   21    Antofagasta - Bajo 252   19.53     19.53   19.53
##   22   Antofagasta - Medio 108    8.37      8.37   27.91
##   91         Temuco - Bajo 232   17.98     17.98   45.89
##   92        Temuco - Medio 129   10.00     10.00   55.89
##  131  Gran Santiago - Bajo 255   19.77     19.77   75.66
##  132 Gran Santiago - Medio 216   16.74     16.74   92.40
##  133  Gran Santiago - Alto  98    7.60      7.60  100.00
##   NA                    NA   0    0.00        NA      NA

3.2 Distribución encuestado

epsoc <- epsoc %>% 
  mutate(rango_edad = rec(edad.seleccionado,
                          rec = "1:17 =  1[menor de 18 años];
                                 18:24 = 2[18 a 24 años]; 
                                 25:44 = 3[25 a 44 años];
                                 45:59 = 4[45 a 59 años]"))

frq(epsoc, rango_edad)
## 
## # rango_edad <numeric> 
## # total N=1290  valid N=1289  mean=3.25  sd=0.71
##  
##  val            label frq raw.prc valid.prc cum.prc
##    1 menor de 18 años   0    0.00      0.00    0.00
##    2     18 a 24 años 201   15.58     15.59   15.59
##    3     25 a 44 años 567   43.95     43.99   59.58
##    4     45 a 59 años 521   40.39     40.42  100.00
##   NA               NA   1    0.08        NA      NA
epsoc %>% 
  filter(is.na(rango_edad)) %>%
  select(sexo.seleccionado, edad.seleccionado, situacion.laboral.seleccionado)
## # A tibble: 1 x 3
##   sexo.seleccionado edad.seleccionado situacion.laboral.seleccionado
##           <dbl+lbl>             <dbl>                      <dbl+lbl>
## 1        1 [Hombre]                60                    1 [Trabaja]

Probablemente discrepancia de edad para las personas mayores de 59 años se debe a una confusión entre edad reportada o fecha de cumpleaños. Podría también tratarse de casos que tenían 59 años al momento de hacerse la encuesta, pero que al momento de validar los datos ya hayan cumplido los 60 .Quedarán asignados al grupo de edad rango_edad == 4.

epsoc <- epsoc %>% 
  mutate(rango_edad = replace(rango_edad, edad.seleccionado %in% c(60, 61), 4))

epsoc %>% 
  count(sexo.seleccionado, rango_edad, situacion.laboral.seleccionado) %>% 
  mutate_all(as_label) %>% 
  mutate(prop = round(n/sum(n), 4)) %>% 
  kable() %>% 
  kable_estilo()
sexo.seleccionado rango_edad situacion.laboral.seleccionado n prop
Hombre 18 a 24 años Trabaja 46 0.0357
Hombre 18 a 24 años No trabaja 50 0.0388
Hombre 25 a 44 años Trabaja 183 0.1419
Hombre 25 a 44 años No trabaja 18 0.0140
Hombre 45 a 59 años Trabaja 144 0.1116
Hombre 45 a 59 años No trabaja 26 0.0202
Mujer 18 a 24 años Trabaja 33 0.0256
Mujer 18 a 24 años No trabaja 72 0.0558
Mujer 25 a 44 años Trabaja 237 0.1837
Mujer 25 a 44 años No trabaja 129 0.1000
Mujer 45 a 59 años Trabaja 195 0.1512
Mujer 45 a 59 años No trabaja 157 0.1217

3.3 Duración entrevistas

La distribución de la duración de las entrevistas registrada por las tablets se puede ver en la siguiente figura.

homologar_fechas <- function(fecha){
  fecha %>% 
    str_replace_all(c("^\\D{3} " = "", '(.*)(\\d{4}$)' = '\\2 \\1')) %>% 
    anytime::anytime()
}

epsoc <- epsoc %>% 
  mutate_at(vars(starts_with('time')), homologar_fechas)
epsoc <- epsoc %>% 
  mutate(duration = str_replace_all(duration, c('-' = '', '^(\\d{2})' = '0\\.\\1'))) %>% 
  separate(duration, into = c('dura.d', 'duracion'), sep = '\\.', convert = TRUE, remove = FALSE) %>% 
  mutate(duracion.t = as.duration(hms(duracion) + hms(hms::hms(hour = (24 * dura.d)))))

epsoc$duracion.t.min <- epsoc$duracion.t@.Data/60

epsoc %>% 
  ggplot(aes(x = duracion.t.min)) + 
  geom_histogram(binwidth = 5) +
  theme_bw() +
  ggtitle("Distribución duración entrevistas por región (escala truncada < 150 minutos)") +
  labs(x = "Duración total entrevista (minutos)",
       y = "Frecuencia") +
  coord_cartesian(xlim = 0:150) +
  scale_x_continuous(breaks = seq(0, 150, by = 15)) +
  facet_grid(as_factor(region) ~ .)

Existen 69 entrevistas que duran menos de 20 minutos, estas debieran ser supervisadas.

epsoc %>%
  filter(as.double(duracion.t.min) < 20) %>%
  select(folio, duracion.t.min) %>% 
  knitr::kable(col.names = c("Folio", "Duración (minutos)"),
               caption = "Entrevistas de menos de 20 minutos",
               digits = 1) %>% 
  kable_estilo() %>% 
  column_spec(1, width = "10em") %>% 
  column_spec(2, width = "10em")
Entrevistas de menos de 20 minutos
Folio Duración (minutos)
200329 19.8
201186 18.2
201293 19.7
201350 11.4
201434 19.9
201863 16.0
201921 16.4
201947 19.1
202382 19.4
202465 19.6
202879 16.4
202895 19.3
203190 18.7
203372 18.4
203836 17.9
204065 19.0
204396 19.5
204867 16.4
204966 18.6
205039 17.2
205443 19.4
205484 16.6
207431 16.9
207456 19.4
207464 14.2
207969 19.1
208017 18.5
208462 19.8
901025 20.0
901157 20.0
901181 18.1
901850 17.2
901868 17.8
902296 17.6
902312 19.2
902411 18.8
902452 19.9
902775 18.9
902940 17.9
903013 19.3
903088 20.0
903336 19.9
903393 18.1
903476 18.2
903518 19.6
903575 19.2
903971 19.3
904425 19.5
904755 17.4
905224 18.2
905240 17.6
905273 18.4
1301191 19.2
1305671 17.4
1305697 18.4
1306489 19.7
1309111 19.4
1310127 12.8
1310135 19.6

Existen 46 entrevistas que duran más de 150 minutos, estas debieran ser supervisadas.

epsoc %>%
  filter(as.double(duracion.t.min) > 150) %>%
  transmute(folio, duracion.t.min / 60) %>% 
  knitr::kable(col.names = c("Folio", "Duración (horas)"),
               caption = "Entrevistas de más de 150 minutos",
               digits = 1) %>% 
  kable_estilo() %>% 
  column_spec(1, width = "10em") %>% 
  column_spec(2, width = "10em")
Entrevistas de más de 150 minutos
Folio Duración (horas)
200444 72.8
200527 69.8
200550 4.6
200717 49.6
202135 71.9
202671 25.7
203349 3.4
900183 2.6
902569 2.7
903443 235.0
903815 236.7
903922 91.3
903963 120.9
905976 14.3
1301928 18.6
1301951 192.9
1302157 4.2
1302421 96.4
1303254 25.1
1303262 25.6
1303643 24.6
1303833 4.0
1303999 6.9
1304062 23.6
1304732 24.4
1305465 23.4
1305515 72.0
1306646 2.8
1306877 44.6
1307214 2.5
1307339 218.9
1307370 50.1
1310192 13.7
1310515 22.6
1311471 5.2
1312958 50.4

3.4 Producción por día

Cantidad de encuestas realizadas por día.

## Comienzo encuesta
epsoc$time1.hms <- hms::as.hms(epsoc$time1)
epsoc$time1.wday <- lubridate::wday(epsoc$time1)
epsoc$time1.dmy <- date(epsoc$time1)

epsoc %>% 
  count(time1.dmy) %>% 
  mutate(n_mean = mean(n)) %>%  
  ggplot(aes(x = time1.dmy, y = n)) +
  geom_line() +
  geom_smooth(method = 'loess', formula = y ~ x) +
  geom_hline(aes(yintercept = n_mean), colour = 'green') +
  geom_label(aes(x = min(time1.dmy)[[1]], y = n_mean[[1]], label = round(n_mean, 1))) +
  labs(title = 'Número de encuestas por día') +
  scale_x_date(breaks = '2 weeks') +
  coord_cartesian(ylim = c(0, 40))

epsoc %>% 
  count(time1.wday) %>% 
  mutate(n_mean = mean(n)) %>%  
  ggplot(aes(x = time1.wday, y = n)) +
  geom_line() +
  geom_smooth(method = 'loess', formula = y ~ x) +
  geom_hline(aes(yintercept = n_mean), colour = 'green') +
  geom_label(aes(x = min(time1.wday)[[1]], y = n_mean[[1]], label = round(n_mean, 1))) +
  labs(title = 'Número de encuestas por día de la semana') +
  scale_x_continuous(breaks = seq(7)) +
  coord_cartesian(ylim = c(0, 500))

3.5 Georeferrenciación

Existen 354 entrevistas sin datos de georreferenciación:

epsoc %>% 
  select(folio, latitude, srvyr) %>% 
  group_by(srvyr) %>% 
  mutate(n.enc = length(folio)) %>% 
  filter(is.na(latitude)) %>%
  select(folio, srvyr, n.enc) %>% 
  mutate(n.enc.sg = (length(folio)/n.enc)*100) %>%       
  arrange(srvyr, folio) %>% 
  group_by_at(vars(-folio)) %>% 
  nest() %>% 
  mutate(Folio = map_chr(data, ~ flatten(.) %>% str_c(., collapse = ', '))) %>% 
  select(-data) %>% 
  kable(digits = 1, 
        col.names = c("Encuestador", "Total encuestas", "% sin georef.", "folios")) %>% 
  kable_estilo()
Encuestador Total encuestas % sin georef. folios
ageraldo.2 66 42.4 200857, 201376, 201475, 201715, 201939, 202143, 202465, 202598, 202770, 203034, 203042, 203083, 203216, 203224, 203240, 203315, 203331, 203570, 203877, 203885, 204040, 204081, 204289, 204297, 204719, 205237, 205252, 208512
atoledo.9 277 2.9 901561, 902783, 903823, 903849, 904144, 904177, 904524, 906164
cobando.9 26 23.1 903344, 903443, 903450, 903625, 903658, 906438
i.perez 24 33.3 1300433, 1301514, 1301530, 1302850, 1312610, 1312636, 1312644, 1312669
j.morales 11 9.1 1305465
jossio.2 100 50.0 200253, 200493, 200691, 201038, 201053, 201061, 201186, 201293, 201392, 201491, 201590, 201749, 201863, 202192, 202226, 202242, 202267, 202382, 202481, 202796, 202879, 202895, 203059, 203067, 203075, 203141, 203190, 203489, 203588, 203752, 203760, 203794, 203836, 203844, 203851, 204396, 204644, 204867, 204966, 205039, 205062, 205484, 205658, 205682, 205872, 206144, 206177, 206763, 207233, 207266
ksakuda.2 35 51.4 201483, 201921, 202473, 202788, 203323, 203372, 203380, 204016, 207415, 207423, 207431, 207449, 207456, 207464, 208017, 208033, 208041, 208058
l.mancilla 24 100.0 901520, 901546, 901553, 901579, 901595, 901868, 901876, 901884, 903112, 903120, 903138, 903146, 903153, 903161, 903179, 903187, 903195, 904342, 904367, 904375, 904383, 904391, 905257, 905281
M.Alert 5 100.0 1305234, 1305242, 1306646, 1310515, 1311471
m.calderon 2 100.0 1310226, 1311935
mdiaz.2 85 7.1 202697, 203117, 203257, 203265, 203273, 205229
mrobles.2 58 51.7 200212, 200477, 201111, 201772, 202218, 202234, 202275, 202572, 204339, 204818, 204875, 205013, 205047, 205450, 205468, 205666, 205690, 205864, 205948, 205963, 206110, 206151, 206318, 206623, 206631, 206714, 207647, 207712, 207936, 208314
ncaceres.2 1 100.0 205930
nicol.alarcon 6 100.0 1310127, 1310135, 1310150, 1310168, 1310176, 1310192
p.aguilera 4 75.0 1300912, 1300953, 1303726
p.gajardo 7 42.9 1302934, 1303510, 1303528
p.vegazo 150 6.7 1300870, 1303825, 1304542, 1309111, 1309129, 1309137, 1309160, 1309178, 1311331, 1311364
rfigueroa.9 8 100.0 901918, 901926, 902023, 902056, 902072, 905919, 905943, 905950
s.gonzalez 16 75.0 1301910, 1301928, 1301936, 1301944, 1301951, 1301969, 1302066, 1303916, 1303940, 1303965, 1305911, 1307057
v.becerra 2 100.0 1300672, 1300698
v.espinoza 103 2.9 1304575, 1310572, 1310580
v.sierra 171 69.0 1300151, 1300169, 1300177, 1300185, 1300193, 1300250, 1300268, 1300276, 1300284, 1300292, 1300474, 1300482, 1300490, 1300557, 1300565, 1300573, 1300581, 1300599, 1300789, 1300797, 1301373, 1301381, 1301399, 1301571, 1301589, 1301597, 1301779, 1301787, 1301795, 1301878, 1301894, 1302074, 1302082, 1302090, 1302470, 1302488, 1302496, 1302678, 1302686, 1302694, 1302777, 1302785, 1302793, 1303155, 1303163, 1303171, 1303189, 1303197, 1303676, 1303684, 1303692, 1303775, 1303783, 1303791, 1303973, 1303999, 1304161, 1304187, 1304195, 1304484, 1304492, 1305077, 1305085, 1305093, 1305994, 1306042, 1306059, 1306067, 1306075, 1306083, 1306091, 1306117, 1306281, 1306299, 1306356, 1306364, 1306372, 1306380, 1306398, 1306596, 1306679, 1306695, 1306851, 1306869, 1307172, 1307180, 1307198, 1307214, 1307230, 1307263, 1307271, 1307289, 1307297, 1308642, 1308659, 1308667, 1308675, 1308683, 1308691, 1308915, 1308923, 1308931, 1308949, 1308956, 1308964, 1308972, 1308980, 1308998, 1310366, 1310374, 1310382, 1311158, 1311166, 1311174, 1311182, 1311190, 1312685, 1312693
ycifuente.9 4 50.0 901314, 901322

3.6 Puntos de encuestas

epsoc_geo <- epsoc %>% 
  select(folio, sbj.num, region, srvyr, longitude, latitude) %>% 
  filter(!is.na(latitude)) %>% 
  sf::st_as_sf(coords = c('longitude', 'latitude'),
               crs = "+proj=longlat +ellps=GRS80")

sf::write_sf(epsoc_geo,
             here::here('validacion_epsoc_puntos_respuesta.kml'),
             dataset_options=c("NameField=folio"),
             delete_dsn=TRUE)

3.6.1 Antofagasta

epsoc_geo %>% 
  filter(region == 2) %>% 
  ggplot(aes(color = srvyr)) +
  geom_sf() 

3.6.2 Temuco

epsoc_geo %>% 
  filter(region == 9) %>% 
  ggplot(aes(color = srvyr)) +
  geom_sf()

3.6.3 Santiago

epsoc_geo %>% 
  filter(region == 13) %>% 
  ggplot(aes(color = srvyr)) +
  geom_sf()

4 Experimentos

EPSOC contiene dos experimentos que constituyen un foco de análisis del instrumento. El primer experimento consiste en un diseño factorial a través viñetas. El segundo se trata de una aleatorización del orden de preguntas sobre recompensa percibida y justa para tres objetos de evaluación: un obrero, un presidente de empresa y el respondente. Actualmente no es posible validar estos experimento por falta de información.

4.1 Viñetas

Para validar el proceso con las viñetas necesitamos:

  • Una breve explicación de cómo está codificado el experimento de las viñetas en la base de datos
  • La base de datos que asocia los folios con sets de viñeta en orden presentado
  • Acceso a grabaciones de voz durante el proceso de entrevista para asegurarnos que están bien asociadas las escalas con las variables

4.1.1 Distribución de viñetas

Revisar la distribución efectiva captada de los decks de viñetas en terreno hasta el momento.

epsoc %>% 
  select(folio, i.1.grupo) %>% 
  head()
## # A tibble: 6 x 2
##    folio i.1.grupo
##    <dbl> <chr>    
## 1 200139 23       
## 2 200147 17       
## 3 200162 11       
## 4 200212 15       
## 5 200220 15       
## 6 200238 31
epsoc %>% 
  transmute(i.1.grupo = as.integer(i.1.grupo),
            region) %>% 
  group_by_all() %>% 
  count() %>% 
  group_by(region) %>% 
  mutate(n_mean = mean(n)) %>% 
  ggplot(aes(x = as_factor(i.1.grupo), y = n)) +
  geom_col() +
  geom_hline(aes(group = region, yintercept = n_mean), colour = 'green') + 
  geom_text(aes(label = ..y..), nudge_y = 1, size = 3) +
  facet_grid(rows = vars(region)) +
  labs(title = 'Distribución de viñetas')
## Don't know how to automatically pick scale for object of type haven_labelled. Defaulting to continuous.

4.1.2 Duración ejercicio

  • Los marcadores de tiempo time2 y time3 no siguen un formato homogéneo para registrar la hora. Por ejemplo, en algún caso se utiliza el formato “2018-10-27T19:05:08-03:00” y en otros “Fri Oct 19 13:01:59 -0300 2018”
  • Homogeneizar formatos de tiempos y fechas a ISO8601
## Comienzo viñetas
epsoc$time2.hms <- hms::as.hms(epsoc$time2)
epsoc$time2.dmy <- date(epsoc$time2)

## Fin viñetas
epsoc$time3.hms <- hms::as.hms(epsoc$time3)
epsoc$time3.dmy <- date(epsoc$time3)

epsoc$dura.vinetas <- difftime(epsoc$time3, epsoc$time2,
                               units = "mins")

ggplot(epsoc, aes(x = time2.dmy, y = time2.hms)) + 
  geom_point(alpha = 0.6) +
  labs(x = "Día", y = "Hora") + 
  ggtitle("Día y hora comienzo actividad viñetas") + 
  theme_bw()

ggplot(epsoc, aes(x = srvyr, y = time2.hms)) + 
  geom_point(alpha = 0.6) +
  labs(x = "Encuestador", y = "Hora") + 
  ggtitle("Hora comienzo actividad viñetas según encuestador") + 
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 90, vjust = .5, hjust = 1))

epsoc %>% 
  mutate(vin.cort = ifelse(dura.vinetas < 5, "< 5'", ">= 5'")) %>% 
  ggplot(aes(dura.vinetas)) + 
  geom_histogram(aes(fill = vin.cort)) + theme_bw() +
  theme(legend.title=element_blank()) +
  ggtitle("Duración ejercicio viñetas") +
  xlab("Minutos")

Como se puede ver en la figura anterior, la distribución del tiempo de duración del ejercicio de viñetas es variable. En términos de validación, llama la atención que se logre realizar el ejercicio en menos de cinco minutos. Estos casos deberían ser revisados apenas sea posible.

ggplot(epsoc, aes(x = srvyr, y = if_else(dura.vinetas < 60, dura.vinetas, 60), 
                  colour = status)) + 
  geom_point(alpha = 0.5,
             position = position_jitter(width = .2)) +
  scale_color_manual(values = c('green', 'orange', 'blue')) + 
  facet_grid(cols = vars(region), scales = 'free_x', space = 'free_x') +
  labs(x = "Encuestador", y = "minutos") + 
  ggtitle("Duración de actividad viñetas según encuestador según región") + 
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 90, vjust = .5, hjust = 1))
## Don't know how to automatically pick scale for object of type difftime. Defaulting to continuous.

En particular, deben supervisarse las siguientes entrevistas donde el ejercicio duró menos de 4 minutos:

kable(epsoc %>% 
        group_by(srvyr) %>% 
        mutate(n.enc = length(folio)) %>% 
        select(folio, dura.vinetas, srvyr, n.enc) %>% 
        filter(dura.vinetas <= 4) %>%
        mutate(n.enc.cort = (length(folio)/n.enc)*100) %>% 
        arrange(srvyr, dura.vinetas), 
      digits = 1,
      col.names = c("Folio", "Duración viñetas", "Encuestador", "Total encuestas", "% cortas"),
      caption = "Ejercicio viñetas de menos de 5 minutos") %>% 
  kable_estilo() #%>% 
Ejercicio viñetas de menos de 5 minutos
Folio Duración viñetas Encuestador Total encuestas % cortas
#column_spec(1, width = "10em") %>% 
#column_spec(2, width = "10em") %>% 
#column_spec(3, width = "10em")

4.1.3 Reconstrucción de variables de outcome

labels_correcion <- function(.vect) {
  replace(.vect, .vect == 6, -1) %>% 
    remove_labels(labels = '- 1') %>% 
    add_labels(labels = c('- 1' = -1))
}

gg_ideologia_orden <- function(.data, var_orden, miss = 88){
  var_orden_quo <- enquo(var_orden)
  
  .data %>% 
    gather('variable', 'valor', -!!var_orden_quo) %>% 
    filter(valor < miss) %>%
    ggplot(aes(x = valor)) +
    geom_bar() +
    facet_grid(rows = vars(variable),
               cols = vars(!!var_orden_quo))
}

4.1.3.1 Ideología para ego y alter

Folios con problemas en la asignación de respuestas de viñetas.

sbj.num_correccion_orden <- epsoc %>% 
  slice(c(132, 461, 845, 940)) %>% 
  pull(sbj.num) %>% 
  as.integer()

sbj.num_correccion_orden <- structure(c(1L, 0L, 3L, 3L),
                                      names= sbj.num_correccion_orden)

str(sbj.num_correccion_orden)
##  Named int [1:4] 1 0 3 3
##  - attr(*, "names")= chr [1:4] "83733275" "80243703" "84150076" "76893775"

Correción de i.1.orden par dos caso

epsoc <- epsoc %>% 
  mutate(i.1.orden.bak = i.1.orden,
         i.1.orden = if_else(sbj.num %in% names(sbj.num_correccion_orden), 
                             sbj.num_correccion_orden[as.character(sbj.num)], 
                             i.1.orden)) %>% 
  var_labels(i.1.orden = 'Orden de respuesta en preguntas de viñetas. Valores corregidos',
             i.1.orden.bak = 'Orden de respuesta en preguntas de viñetas. Valores originales')

epsoc %>% 
  filter(sbj.num %in% as.integer(names(sbj.num_correccion_orden))) %>% 
  select(sbj.num, i.1.orden, i.1.orden.bak)
## # A tibble: 4 x 3
##    sbj.num i.1.orden i.1.orden.bak
##      <dbl>     <int>         <int>
## 1 83733275         1             1
## 2 80243703         0             2
## 3 84150076         3             3
## 4 76893775         3             2
ideologia_ego <- list(orden1 = c("c0.1", "c1.1.1", "c1.2.1", "c1.3.1", "c1.4.1", "c2.1.1", "c2.2.1", "c2.3.1", "c2.4.1"),
                      orden2 = c("c0.2", "c1.4.2", "c1.1.2", "c1.2.2", "c1.3.2", "c2.4.2", "c2.1.2", "c2.2.2", "c2.3.2"),
                      orden3 = c("c0.3", "c1.3.3", "c1.4.3", "c1.1.3", "c1.2.3", "c2.3.3", "c2.4.3", "c2.1.3", "c2.2.3"), 
                      orden4 = c("c0.4", "c1.2.4", "c1.3.4", "c1.4.4", "c1.1.4", "c2.2.4", "c2.3.4", "c2.4.4", "c2.1.4"))

df_ideologia_ego <- epsoc %>% 
  select(folio, i.1.orden, !!!flatten_chr(ideologia_ego)) %>% 
  nest(-i.1.orden) %>% 
  arrange(i.1.orden)

df_ideologia_ego <- df_ideologia_ego %>% 
  mutate(orden = ideologia_ego[str_glue("orden{i.1.orden + 1}")],
         data = map2(data, orden, ~select(.x, one_of("folio", .y))),
         data_var = map(data, names) %>% map_chr(str_c, collapse = ', '))

df_ideologia_ego
## # A tibble: 4 x 4
##   i.1.orden data          orden   data_var                                 
##       <int> <list>        <list>  <chr>                                    
## 1         0 <tibble [306… <chr [… folio, c0.1, c1.1.1, c1.2.1, c1.3.1, c1.…
## 2         1 <tibble [346… <chr [… folio, c0.2, c1.4.2, c1.1.2, c1.2.2, c1.…
## 3         2 <tibble [327… <chr [… folio, c0.3, c1.3.3, c1.4.3, c1.1.3, c1.…
## 4         3 <tibble [311… <chr [… folio, c0.4, c1.2.4, c1.3.4, c1.4.4, c1.…
map_dfc(df_ideologia_ego$data, get_label) %>% 
  mutate_all(str_trunc, width = 25)
## # A tibble: 10 x 4
##    V1                 V2                V3                V4               
##    <chr>              <chr>             <chr>             <chr>            
##  1 ""                 ""                ""                ""               
##  2 Observe esta esca… Observe esta esc… Observe esta esc… Observe esta esc…
##  3 "Escala \"Las fam… "Escala \"Las fa… "Escala \"Las fa… "Escala \"Las fa…
##  4 "Escala \"Chile n… "Escala \"Chile … "Escala \"Chile … "Escala \"Chile …
##  5 "Escala \"Educaci… "Escala \"Educac… "Escala \"Educac… "Escala \"Educac…
##  6 "Escala \"Más con… "Escala \"Más co… "Escala \"Más co… "Escala \"Más co…
##  7 "Escala \"Las fam… "Escala \"Las fa… "Escala \"Las fa… "Escala \"Las fa…
##  8 "Escala \"Chile n… "Escala \"Chile … "Escala \"Chile … "Escala \"Chile …
##  9 "Escala \"Educaci… "Escala \"Educac… "Escala \"Educac… "Escala \"Educac…
## 10 "Escala \"Más con… "Escala \"Más co… "Escala \"Más co… "Escala \"Más co…
suppressWarnings(
  df_ideologia_ego <- df_ideologia_ego %>% 
    mutate(data = map(data, ~rename_all(.x, ~c("folio", str_remove(ideologia_ego$orden1,'.\\d{1,2}$'))))) %>% 
    select(data) %>% 
    unnest()
)

df_ideologia_ego <- copy_labels(df_new = df_ideologia_ego,
                                df_origin = epsoc %>% 
                                  select(one_of(c('folio', ideologia_ego$orden1))) %>% 
                                  rename_all(~c("folio", str_remove(ideologia_ego$orden1,'.\\d{1,2}$'))))

Agregar variables reconstruidas a base de datos.

epsoc <- left_join(epsoc, 
                   df_ideologia_ego,
                   by = 'folio')
## Warning: Column `folio` has different attributes on LHS and RHS of join
epsoc %>% 
  select(i.1.orden, matches("c[1-2].\\d{1}$")) %>% 
  gather('variable', 'valor', -i.1.orden) %>% 
  mutate(referencia = if_else(str_detect(variable, 'c1.*'), 'ego', 'alter'),
         outcome = str_extract(variable, '(\\d*)$')) %>% 
  filter(valor < 88) %>% 
  ggplot(aes(x = valor, fill = fct_rev(referencia))) +
  geom_bar(position = position_dodge()) +
  facet_grid(rows = vars(outcome),
             cols = vars(i.1.orden)) +
  labs(title = 'Distribución de viñetas ego y alter, según orden de preguntas') +
  scale_fill_discrete(name = 'Referencia')
## Warning: attributes are not identical across measure variables;
## they will be dropped

4.1.3.2 Ideología para viñetas

Primero es necesario reunir las variables

ideologia_vin <- list(orden1 = c(1, 2, 3, 4),
                      orden2 = c(4, 1, 2, 3),
                      orden3 = c(3, 4, 1, 2), 
                      orden4 = c(2, 3, 4, 1))

df_ideologia_vin <- epsoc %>% 
  select(folio, i.1.orden, matches("^c([3-9]|10)\\.[1-4].*")) %>% 
  nest(-i.1.orden) %>% 
  arrange(i.1.orden)

ideologia_variables <- function(persona, orden, grupo){
  expand.grid(persona, orden, grupo) %>% 
  arrange(Var1) %>% 
  str_glue_data("c{Var1}.{Var2}.{Var3}")
}

df_ideologia_vin <- df_ideologia_vin %>% 
  mutate(orden = ideologia_vin[str_glue("orden{i.1.orden + 1}")],
         variables = map2(orden, i.1.orden + 1, ~ideologia_variables(3:10, .x, .y)),
         data = map2(data, variables, ~select(.x, one_of("folio", .y))),
         data_var = map(data, names) %>% map_chr(str_c, collapse = ', '))

df_ideologia_vin %>% 
  select(i.1.orden, data_var)
## # A tibble: 4 x 2
##   i.1.orden data_var                                                       
##       <int> <chr>                                                          
## 1         0 folio, c3.1.1, c3.2.1, c3.3.1, c3.4.1, c4.1.1, c4.2.1, c4.3.1,…
## 2         1 folio, c3.4.2, c3.1.2, c3.2.2, c3.3.2, c4.4.2, c4.1.2, c4.2.2,…
## 3         2 folio, c3.3.3, c3.4.3, c3.1.3, c3.2.3, c4.3.3, c4.4.3, c4.1.3,…
## 4         3 folio, c3.2.4, c3.3.4, c3.4.4, c3.1.4, c4.2.4, c4.3.4, c4.4.4,…
etiquetas <- map(df_ideologia_vin$data, get_labels)
ideologia_vin1_names <- names(df_ideologia_vin$data[[1]])
ideologia_vin1_gen_names <- str_remove(ideologia_vin1_names, '.\\d{1,2}$')

suppressWarnings(
  df_ideologia_vin <- df_ideologia_vin %>% 
    mutate(data = map(data, ~rename_all(.x, ~ideologia_vin1_gen_names))) %>% 
    select(data) %>% 
    unnest()
)

df_ideologia_vin <- copy_labels(df_new = df_ideologia_vin,
                                df_origin = epsoc %>% 
                                  select(!!!ideologia_vin1_names) %>% 
                                  rename_all(~ideologia_vin1_gen_names))

head(df_ideologia_vin)
## # A tibble: 6 x 33
##    folio  c3.1  c3.2  c3.3  c3.4  c4.1  c4.2  c4.3  c4.4  c5.1  c5.2  c5.3
##    <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 200162     1     1    11     1     1     1    11     1    11     1     1
## 2 200238    11    10     1     2     2     1    11    11     3     3    10
## 3 200246    11     1    11     1     1    11    11    11    11     1     1
## 4 200329     4    11    10     3     4     9     3     3     8     3    10
## 5 200337     2     2     1     1     6    10     1     1     1     9     3
## 6 200410     1     1     1     1    11    11     1     1    11    11     1
## # … with 21 more variables: c5.4 <dbl>, c6.1 <dbl>, c6.2 <dbl>,
## #   c6.3 <dbl>, c6.4 <dbl>, c7.1 <dbl>, c7.2 <dbl>, c7.3 <dbl>,
## #   c7.4 <dbl>, c8.1 <dbl>, c8.2 <dbl>, c8.3 <dbl>, c8.4 <dbl>,
## #   c9.1 <dbl>, c9.2 <dbl>, c9.3 <dbl>, c9.4 <dbl>, c10.1 <dbl>,
## #   c10.2 <dbl>, c10.3 <dbl>, c10.4 <dbl>

Agregar variables reconstruidas a base de datos.

epsoc <- left_join(epsoc, 
                   df_ideologia_vin,
                   by = 'folio')
## Warning: Column `folio` has different attributes on LHS and RHS of join

Gráficos para comparar distribuciones entre viñetas y orden

epsoc %>% 
  select(i.1.orden, matches('c([3-9]|10).1$')) %>% 
  gg_ideologia_orden(i.1.orden) +
  labs(title = 'Distribución de viñetas Familias, según orden de preguntas')
## Warning: attributes are not identical across measure variables;
## they will be dropped

epsoc %>% 
  select(i.1.orden, matches('c([3-9]|10).2$')) %>% 
  gg_ideologia_orden(i.1.orden) +
  labs(title = 'Distribución de viñetas Orden o Cambio, según orden de preguntas')
## Warning: attributes are not identical across measure variables;
## they will be dropped

epsoc %>% 
  select(i.1.orden, matches('c([3-9]|10).3$')) %>% 
  gg_ideologia_orden(i.1.orden) +
  labs(title = 'Distribución de viñetas Educación, según orden de preguntas')
## Warning: attributes are not identical across measure variables;
## they will be dropped

epsoc %>% 
  select(i.1.orden, matches('c([3-9]|10).4$')) %>% 
  gg_ideologia_orden(i.1.orden) +
  labs(title = 'Distribución de viñetas Grandes Empresas, según orden de preguntas')
## Warning: attributes are not identical across measure variables;
## they will be dropped

tab_correccion_orden <- epsoc %>% 
  filter(sbj.num %in% as.numeric(names(sbj.num_correccion_orden))) %>% 
  select(i.1.orden, matches('c[3-9].*'), -c3.orden) %>% 
  t()

tab_correccion_orden[str_detect(rownames(tab_correccion_orden), 'i.1.orden|c[3-4]\\.1\\.?[1-4]?$'), ]
##           [,1] [,2] [,3] [,4]
## i.1.orden    1    0    3    3
## c3.1.1      NA    5   NA   NA
## c4.1.1      NA    9    6   NA
## c3.1.2       1   NA   NA   NA
## c4.1.2       1   NA   NA   NA
## c3.1.3      NA   NA   NA   NA
## c4.1.3      NA   NA   NA   NA
## c3.1.4      11   NA    1    7
## c4.1.4       1   NA    4    4
## c3.1         1    5    1    7
## c4.1         1    9    9    3

4.2 Recompensa justa

Para validar el experimento de evaluación de justicia necesitamos: - Una breve explicación de cómo están codificados los items de recompensa percibida y recompensa justa para un obrero, el presidente de una empresa y el respondente - Es fundamental saber cuál es la variable que define el orden en que se presentó una y otra pregunta

4.2.1 Distribución de tratamientos

La variable a que determina el tratamiento mostrado en la encuesta es la variable num.grupo.jd.

flat_table(epsoc, num.grupo.jd, region, margin = 'col')
##              region Antofagasta Araucanía Metropolitana
## num.grupo.jd                                           
## 0                         26.39     19.94         23.02
## 1                         24.17     24.38         26.01
## 2                         28.06     27.98         25.31
## 3                         21.39     27.70         25.66

4.2.2 Variables asociadas

Existen 24 variables asociadas al experimiento de recompensa justa que se detallan a continuación:

var_rec_justa <- find_var(epsoc, pattern = stringr::regex('obrero|pdte'), search = 'label')

var_rec_justa$var.label %>% 
  str_replace_all(c('Quisiéramos saber cuánto dinero cree Ud. que ganan las personas al mes en estos trabajos u ocupaciones que se mencionan más adelante, después de considerar los descuentos de salud, previsión u otros impuestos' = 'cuánto dinero cree Ud. que ganan',
                    'Pensando en lo que Ud. cree que las personas en estos trabajos deberían ganar al mes, después de los descuentos de salud, previsión u otros impuestos. ' = '')) %>% 
   paste0(var_rec_justa$var.name, " - ", sort(rep(seq(6), 4)), " - ", .)
##  [1] "i.1.g1a.1.rec - 1 - cuánto dinero cree Ud. que ganan (pdte empresa)"          
##  [2] "i.2.g1a.1.rec - 1 - cuánto dinero cree Ud. que ganan (obrero)"                
##  [3] "i.1.g2a.1.rec - 1 - ¿Cuál sería una remuneración justa para (pdte empresa)?"  
##  [4] "i.2.g2a.1.rec - 1 - ¿Cuál sería una remuneración justa para (obrero)?"        
##  [5] "i.1.g2a.2.rec - 2 - ¿Cuál sería una remuneración justa para (pdte empresa)?"  
##  [6] "i.2.g2a.2.rec - 2 - ¿Cuál sería una remuneración justa para (obrero)?"        
##  [7] "i.1.g1a.2.rec - 2 - cuánto dinero cree Ud. que ganan (pdte empresa)"          
##  [8] "i.2.g1a.2.rec - 2 - cuánto dinero cree Ud. que ganan (obrero)"                
##  [9] "i.1.g1a.3.rec - 3 - cuánto dinero cree Ud. que ganan (pdte empresa)"          
## [10] "i.2.g1a.3.rec - 3 - cuánto dinero cree Ud. que ganan (obrero)"                
## [11] "i.1.g2b.3.rec - 3 - ¿Cuál sería una remuneración justa para (pdte empresa)?"  
## [12] "i.2.g2b.3.rec - 3 - ¿Cuál sería una remuneración justa para (obrero)?"        
## [13] "i.1.g1b.4.rec - 4 - ¿Cuál sería una remuneración justa para (pdte empresa)?"  
## [14] "i.2.g1b.4.rec - 4 - ¿Cuál sería una remuneración justa para (obrero)?"        
## [15] "i.1.g1a.4.rec - 4 - cuánto dinero cree Ud. que ganan (pdte empresa)"          
## [16] "i.2.g1a.4.rec - 4 - cuánto dinero cree Ud. que ganan (obrero)"                
## [17] "i.1.g1a.3.2.rec - 5 - cuánto dinero cree Ud. que ganan (obrero)"              
## [18] "i.2.g1a.3.2.rec - 5 - cuánto dinero cree Ud. que ganan (pdte empresa)"        
## [19] "i.1.g1b.3.2.rec - 5 - ¿Cuál sería una remuneración justa para (obrero)?"      
## [20] "i.2.g1b.3.2.rec - 5 - ¿Cuál sería una remuneración justa para (pdte empresa)?"
## [21] "i.1.g2b.4.2.rec - 6 - ¿Cuál sería una remuneración justa para (obrero)?"      
## [22] "i.2.g2b.4.2.rec - 6 - ¿Cuál sería una remuneración justa para (pdte empresa)?"
## [23] "i.1.g2a.4.2.rec - 6 - cuánto dinero cree Ud. que ganan (obrero)"              
## [24] "i.2.g2a.4.2.rec - 6 - cuánto dinero cree Ud. que ganan (pdte empresa)"

Al inicio de la aplicación del cuestionario se implementó 4 grupos (del grupo 1 al 4 o variables i.1.g1a.1.rec a i.2.g1a.4.rec). Como puede verse el grupo 3 es identico al 1 y el grupo 4 es igual al 2 porque se mantuvo el orden de presidente empresa y luego obrero.

Para solucionarlo, se agregaron los grupos 5 y 6 en donde se se cambia el orden a obrero y luego presidente empresa. Con esto los 4 grupos (1, 2, 5 y 6) a los que cada persona se verá confrontada serán diferentes. Como se puede ver en el gráfico , la implementación del cambio se efectuó correctamente.

epsoc %>% 
  arrange(num.grupo.jd, time1) %>% 
  select(one_of(var_rec_justa$var.name)) %>% 
  naniar::vis_miss() +
  labs(title = 'Distribución de respuestas en preguntas de recompensa justa') +
  theme(axis.text.x = element_text(angle = 90, vjust = .5, hjust = 0))

4.3 Items justicia

La encuesta considera una serie de preguntas con escalas predefinidas. A continuación se revisa que los ítems sobre justicia tengan respuestas en el rango de 1 a 5 o bien valores de 8 o 9.

item_just <- find_var(epsoc, "usto")
item_just$var.name
##  [1] "i.6.a1"  "i.8.a1"  "i.9.a1"  "i.10.a1" "i.11.a1" "i.12.a1" "i.13.a1"
##  [8] "i.16.a1" "i.1.h1"  "i.2.h1"  "i.5.h1"  "i.7.h1"  "i.8.h1"  "i.10.h1"
## [15] "i.11.h1" "i.12.h1" "i.14.h1"
v <- validator(j := var_group(i.6.a1, i.8.a1, i.9.a1, i.10.a1, i.11.a1, i.12.a1, i.13.a1, i.16.a1, 
                              i.1.h1, i.2.h1, i.5.h1, i.7.h1, i.8.h1, i.10.h1, i.11.h1, i.12.h1, i.14.h1), 
               j >= 1,
               j <= 9,
               j != 6,
               j != 7)

cf2 <- confront(epsoc, v)
s.cf2 <- summary(cf2)

knitr::kable(s.cf2) %>% 
  kable_estilo()
name items passes fails nNA error warning expression
V2.1 1290 1290 0 0 FALSE FALSE (i.6.a1 - 1) >= -1e-08
V2.2 1290 1290 0 0 FALSE FALSE (i.8.a1 - 1) >= -1e-08
V2.3 1290 1290 0 0 FALSE FALSE (i.9.a1 - 1) >= -1e-08
V2.4 1290 1290 0 0 FALSE FALSE (i.10.a1 - 1) >= -1e-08
V2.5 1290 1290 0 0 FALSE FALSE (i.11.a1 - 1) >= -1e-08
V2.6 1290 1290 0 0 FALSE FALSE (i.12.a1 - 1) >= -1e-08
V2.7 1290 1290 0 0 FALSE FALSE (i.13.a1 - 1) >= -1e-08
V2.8 1290 1290 0 0 FALSE FALSE (i.16.a1 - 1) >= -1e-08
V2.9 1290 1290 0 0 FALSE FALSE (i.1.h1 - 1) >= -1e-08
V2.10 1290 1290 0 0 FALSE FALSE (i.2.h1 - 1) >= -1e-08
V2.11 1290 1290 0 0 FALSE FALSE (i.5.h1 - 1) >= -1e-08
V2.12 1290 1290 0 0 FALSE FALSE (i.7.h1 - 1) >= -1e-08
V2.13 1290 1290 0 0 FALSE FALSE (i.8.h1 - 1) >= -1e-08
V2.14 1290 1290 0 0 FALSE FALSE (i.10.h1 - 1) >= -1e-08
V2.15 1290 1290 0 0 FALSE FALSE (i.11.h1 - 1) >= -1e-08
V2.16 1290 1290 0 0 FALSE FALSE (i.12.h1 - 1) >= -1e-08
V2.17 1290 1290 0 0 FALSE FALSE (i.14.h1 - 1) >= -1e-08
V3.1 1290 1290 0 0 FALSE FALSE (i.6.a1 - 9) <= 1e-08
V3.2 1290 1290 0 0 FALSE FALSE (i.8.a1 - 9) <= 1e-08
V3.3 1290 1290 0 0 FALSE FALSE (i.9.a1 - 9) <= 1e-08
V3.4 1290 1290 0 0 FALSE FALSE (i.10.a1 - 9) <= 1e-08
V3.5 1290 1290 0 0 FALSE FALSE (i.11.a1 - 9) <= 1e-08
V3.6 1290 1290 0 0 FALSE FALSE (i.12.a1 - 9) <= 1e-08
V3.7 1290 1290 0 0 FALSE FALSE (i.13.a1 - 9) <= 1e-08
V3.8 1290 1290 0 0 FALSE FALSE (i.16.a1 - 9) <= 1e-08
V3.9 1290 1290 0 0 FALSE FALSE (i.1.h1 - 9) <= 1e-08
V3.10 1290 1290 0 0 FALSE FALSE (i.2.h1 - 9) <= 1e-08
V3.11 1290 1290 0 0 FALSE FALSE (i.5.h1 - 9) <= 1e-08
V3.12 1290 1290 0 0 FALSE FALSE (i.7.h1 - 9) <= 1e-08
V3.13 1290 1290 0 0 FALSE FALSE (i.8.h1 - 9) <= 1e-08
V3.14 1290 1290 0 0 FALSE FALSE (i.10.h1 - 9) <= 1e-08
V3.15 1290 1290 0 0 FALSE FALSE (i.11.h1 - 9) <= 1e-08
V3.16 1290 1290 0 0 FALSE FALSE (i.12.h1 - 9) <= 1e-08
V3.17 1290 1290 0 0 FALSE FALSE (i.14.h1 - 9) <= 1e-08
V4.1 1290 1290 0 0 FALSE FALSE i.6.a1 != 6
V4.2 1290 1290 0 0 FALSE FALSE i.8.a1 != 6
V4.3 1290 1290 0 0 FALSE FALSE i.9.a1 != 6
V4.4 1290 1290 0 0 FALSE FALSE i.10.a1 != 6
V4.5 1290 1290 0 0 FALSE FALSE i.11.a1 != 6
V4.6 1290 1290 0 0 FALSE FALSE i.12.a1 != 6
V4.7 1290 1290 0 0 FALSE FALSE i.13.a1 != 6
V4.8 1290 1290 0 0 FALSE FALSE i.16.a1 != 6
V4.9 1290 1290 0 0 FALSE FALSE i.1.h1 != 6
V4.10 1290 1290 0 0 FALSE FALSE i.2.h1 != 6
V4.11 1290 1290 0 0 FALSE FALSE i.5.h1 != 6
V4.12 1290 1290 0 0 FALSE FALSE i.7.h1 != 6
V4.13 1290 1290 0 0 FALSE FALSE i.8.h1 != 6
V4.14 1290 1290 0 0 FALSE FALSE i.10.h1 != 6
V4.15 1290 1290 0 0 FALSE FALSE i.11.h1 != 6
V4.16 1290 1290 0 0 FALSE FALSE i.12.h1 != 6
V4.17 1290 1290 0 0 FALSE FALSE i.14.h1 != 6
V5.1 1290 1290 0 0 FALSE FALSE i.6.a1 != 7
V5.2 1290 1290 0 0 FALSE FALSE i.8.a1 != 7
V5.3 1290 1290 0 0 FALSE FALSE i.9.a1 != 7
V5.4 1290 1290 0 0 FALSE FALSE i.10.a1 != 7
V5.5 1290 1290 0 0 FALSE FALSE i.11.a1 != 7
V5.6 1290 1290 0 0 FALSE FALSE i.12.a1 != 7
V5.7 1290 1290 0 0 FALSE FALSE i.13.a1 != 7
V5.8 1290 1290 0 0 FALSE FALSE i.16.a1 != 7
V5.9 1290 1290 0 0 FALSE FALSE i.1.h1 != 7
V5.10 1290 1290 0 0 FALSE FALSE i.2.h1 != 7
V5.11 1290 1290 0 0 FALSE FALSE i.5.h1 != 7
V5.12 1290 1290 0 0 FALSE FALSE i.7.h1 != 7
V5.13 1290 1290 0 0 FALSE FALSE i.8.h1 != 7
V5.14 1290 1290 0 0 FALSE FALSE i.10.h1 != 7
V5.15 1290 1290 0 0 FALSE FALSE i.11.h1 != 7
V5.16 1290 1290 0 0 FALSE FALSE i.12.h1 != 7
V5.17 1290 1290 0 0 FALSE FALSE i.14.h1 != 7

Existen 0 variables de actitudes sobre justicia fuera de rango.

5 Otros criterios generales

Para validar los datos consideramos los siguientes criterios:

  • El rango etario de la población (18 a 59 años)
  • Una duración de menos de dos horas
  • Una duración de más de quince minutos
  • Las variables con información redundante deben converger (edad y sexo)
  • Número de hijos
epsoc$duration <- chron(times=epsoc$duration)
## Warning in convert.times(times., fmt): NAs introduced by coercion
## Warning in convert.times(times., fmt): time-of-day entries out of range in
## positions NA,NA,NA,NA,NA,NA,NA,NA,NA,NA set to NA
cf <- check_that(epsoc, edad.seleccionado <= 59 & edad.seleccionado >= 18,
                 sexo.enc == sexo.seleccionado)
s.cf <- summary(cf)
knitr::kable(s.cf) %>% 
        kable_estilo()
name items passes fails nNA error warning expression
V1 1290 1289 1 0 FALSE FALSE edad.seleccionado <= 59 & edad.seleccionado >= 18
V2 1290 1278 12 0 FALSE FALSE abs(sexo.enc - sexo.seleccionado) < 1e-08

Resultados:

  • Existen 1 respondentes fuera del rango etario.
  • Existen 12 divergencias respecto al sexo del encuestado al comparar la variable sexo.enc y sexo.seleccionado.

5.1 Edad

## Fecha de nacimiento y edad seleccionado
epsoc$enc.edad[as.character(epsoc$enc.edad) == "1582-10-14"] <- NA # comportamiento extraño al importar desde SPSS
edad <- tibble(Folio = epsoc$folio[is.na(epsoc$enc.edad)],
               Fecha = epsoc$enc.edad[is.na(epsoc$enc.edad)],
               Edad = epsoc$edad.seleccionado[is.na(epsoc$enc.edad)]) 
knitr::kable(edad,
             caption = "Casos sin fecha de nacimiento en `enc_edad`",
             col.names = c("Folio", "Fecha nacimiento", "Edad")) %>% 
  kable_estilo()
Casos sin fecha de nacimiento en enc_edad
Folio Fecha nacimiento Edad
201350 NA 56
201467 NA 59
202457 NA 18
202580 NA 59
203182 NA 39
203273 NA 59
203315 NA 52
205237 NA 59
900134 NA 59
900753 NA 53
900779 NA 59
900829 NA 40
900845 NA 59
900878 NA 59
901041 NA 59
901066 NA 59
901082 NA 39
901132 NA 59
901181 NA 18
901579 NA 40
901876 NA 59
901918 NA 25
902338 NA 56
902361 NA 59
902379 NA 59
902411 NA 59
902429 NA 59
902478 NA 59
902510 NA 59
902759 NA 36
902924 NA 59
903336 NA 59
903351 NA 59
903419 NA 59
903518 NA 59
903526 NA 59
903567 NA 59
903955 NA 59
904144 NA 56
904383 NA 53
904565 NA 43
904631 NA 59
904649 NA 58
904664 NA 59
904698 NA 59
904722 NA 59
904771 NA 59
905224 NA 59
905273 NA 59
905299 NA 59
905364 NA 59
905422 NA 59
905448 NA 59
905471 NA 51
905877 NA 20
905976 NA 59
1302538 NA 47
1303270 NA 34
1303577 NA 39
1309913 NA 49
1310150 NA 55
1310168 NA 27
1310176 NA 52
1310192 NA 35
1311935 NA 24
1312438 NA 48

5.2 Sexo

epsoc %>% 
  filter(sexo.enc != sexo.seleccionado) %>% 
  select(Folio = folio, sexo.enc, sexo.seleccionado) %>% 
  knitr::kable(col.names = c("Folio", "sexo.enc", "sexo.seleccionado"),
               caption = "Entrevistas donde sexo encuestado y seleccionado no coinciden") %>% 
  kable_estilo()
Entrevistas donde sexo encuestado y seleccionado no coinciden
Folio sexo.enc sexo.seleccionado
200444 1 2
201483 1 2
201939 2 1
205237 2 1
902213 1 2
1301928 2 1
1301936 2 1
1301944 2 1
1301969 1 2
1305911 2 1
1307131 2 1
1309913 1 2

5.3 Número de hijos

frq(epsoc$f22)
## 
## # ¿Tiene usted hijos o hijas? ¿Cuántos/as? (x) <numeric> 
## # total N=1290  valid N=1290  mean=2.72  sd=1.45
##  
##  val                 label frq raw.prc valid.prc cum.prc
##    1           No, ninguno 331   25.66     25.66   25.66
##    2                 Uno/a 270   20.93     20.93   46.59
##    3                   Dos 334   25.89     25.89   72.48
##    4                  Tres 220   17.05     17.05   89.53
##    5                Cuatro  90    6.98      6.98   96.51
##    6                 Cinco  22    1.71      1.71   98.22
##    7            Seis o más  19    1.47      1.47   99.69
##    8     No sabe [No leer]   1    0.08      0.08   99.77
##    9 No responde [No leer]   3    0.23      0.23  100.00
##   NA                    NA   0    0.00        NA      NA
hijos <- epsoc %>%
  select(folio, f22:f26.o5) %>%
  mutate(hijo_n       = ifelse(f22 <= 6, f22 - 1, NA),
         hijo_estudia = ifelse(f23 <= 7, f23 - 1, NA),
         hijo_egreso  = ifelse(f25 <= 7, f25 - 1, NA),
         hijo_suma    = hijo_estudia + hijo_egreso) %>%
  filter(hijo_n < hijo_suma)

hijos %>% 
  select(folio, starts_with('hijo')) %>% 
  arrange(desc(abs(hijo_n - hijo_suma)))
## # A tibble: 0 x 5
## # … with 5 variables: folio <dbl>, hijo_n <dbl>, hijo_estudia <dbl>,
## #   hijo_egreso <dbl>, hijo_suma <dbl>

6 Corrección de situación laboral

epsoc <- epsoc %>% 
  mutate(situacion.laboral.seleccionado.2 = rec(f2, 
                      rec = "1:3 = 1[Trabaja];
                      4 = 2 [No trabaja];
                      8 = 2 [No trabaja];
                      9 = 2 [No trabaja];
                      else = 3 [Caso especial]"))
epsoc %>% 
  flat_table(situacion.laboral.seleccionado,situacion.laboral.seleccionado.2)
##                                situacion.laboral.seleccionado.2 Trabaja No trabaja Caso especial
## situacion.laboral.seleccionado                                                                  
## Trabaja                                                             797          8            33
## No trabaja                                                           55         92           305

7 Grabaciones

Grabar base de datos con variables de viñetas reconstruidas.

epsoc %>% 
  mutate_if(is.numeric, as_labelled) %>% 
  haven::write_sav(file.path(path, "EPSOC Base parcial con vinetas.sav"))

8 Obtención de archivos de grabaciones de cada encuesta.

archivos <- dir(path = file.path(path, 'SurveyToGo Attachments', 'EPSOC'),
                recursive = TRUE)

# Códigos de encuestas válidas
epsoc_sbj.num_sort <- paste0("S", sort(epsoc$sbj.num))

# Extracción de archivos válidos
archivos_Validos <- archivos[(str_extract(archivos, "(?=S).*(?=_)") %in% epsoc_sbj.num_sort)]
  
copia <-  file.copy(from = file.path(path, 'SurveyToGo Attachments', 'EPSOC', archivos_Validos),
                    to = file.path(path, "Validacion-EPSOC", "grabaciones"),
                    overwrite = TRUE)

sum(copia)